home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch15 / Trans.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-25  |  19KB  |  574 lines
  1. VERSION 5.00
  2. Begin VB.Form frmTrans 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Trans"
  6.    ClientHeight    =   6225
  7.    ClientLeft      =   690
  8.    ClientTop       =   615
  9.    ClientWidth     =   7830
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    KeyPreview      =   -1  'True
  21.    LinkTopic       =   "Form1"
  22.    PaletteMode     =   1  'UseZOrder
  23.    ScaleHeight     =   415
  24.    ScaleMode       =   3  'Pixel
  25.    ScaleWidth      =   522
  26.    Begin VB.CheckBox chkHideSurfaces 
  27.       Caption         =   "Hide Surfaces"
  28.       Height          =   255
  29.       Left            =   0
  30.       TabIndex        =   22
  31.       Top             =   5280
  32.       Width           =   2295
  33.    End
  34.    Begin VB.CommandButton cmdTransform 
  35.       Caption         =   "Transform"
  36.       Default         =   -1  'True
  37.       Height          =   495
  38.       Left            =   600
  39.       TabIndex        =   12
  40.       Top             =   5640
  41.       Width           =   1095
  42.    End
  43.    Begin VB.Frame Frame1 
  44.       Caption         =   "Transformations"
  45.       Height          =   2535
  46.       Left            =   0
  47.       TabIndex        =   7
  48.       Top             =   2640
  49.       Width           =   2295
  50.       Begin VB.OptionButton optTransformation 
  51.          Caption         =   "Z Rotate"
  52.          Height          =   255
  53.          Index           =   8
  54.          Left            =   120
  55.          TabIndex        =   19
  56.          Top             =   2160
  57.          Width           =   2055
  58.       End
  59.       Begin VB.OptionButton optTransformation 
  60.          Caption         =   "Y Rotate"
  61.          Height          =   255
  62.          Index           =   7
  63.          Left            =   120
  64.          TabIndex        =   18
  65.          Top             =   1920
  66.          Width           =   2055
  67.       End
  68.       Begin VB.OptionButton optTransformation 
  69.          Caption         =   "X Rotate"
  70.          Height          =   255
  71.          Index           =   6
  72.          Left            =   120
  73.          TabIndex        =   17
  74.          Top             =   1680
  75.          Width           =   2055
  76.       End
  77.       Begin VB.OptionButton optTransformation 
  78.          Caption         =   "Grow, Rotate"
  79.          Height          =   255
  80.          Index           =   5
  81.          Left            =   120
  82.          TabIndex        =   16
  83.          Top             =   1440
  84.          Width           =   2055
  85.       End
  86.       Begin VB.OptionButton optTransformation 
  87.          Caption         =   "Wierd"
  88.          Height          =   255
  89.          Index           =   4
  90.          Left            =   120
  91.          TabIndex        =   15
  92.          Top             =   1200
  93.          Width           =   2055
  94.       End
  95.       Begin VB.OptionButton optTransformation 
  96.          Caption         =   "Up, Shrink/Grow"
  97.          Height          =   255
  98.          Index           =   3
  99.          Left            =   120
  100.          TabIndex        =   11
  101.          Top             =   960
  102.          Width           =   2055
  103.       End
  104.       Begin VB.OptionButton optTransformation 
  105.          Caption         =   "Up, Shrink, Twist"
  106.          Height          =   255
  107.          Index           =   2
  108.          Left            =   120
  109.          TabIndex        =   10
  110.          Top             =   720
  111.          Width           =   2055
  112.       End
  113.       Begin VB.OptionButton optTransformation 
  114.          Caption         =   "Up, Shrink"
  115.          Height          =   255
  116.          Index           =   1
  117.          Left            =   120
  118.          TabIndex        =   9
  119.          Top             =   480
  120.          Width           =   2055
  121.       End
  122.       Begin VB.OptionButton optTransformation 
  123.          Caption         =   "Up, Twist"
  124.          Height          =   255
  125.          Index           =   0
  126.          Left            =   120
  127.          TabIndex        =   8
  128.          Top             =   240
  129.          Value           =   -1  'True
  130.          Width           =   2055
  131.       End
  132.    End
  133.    Begin VB.Frame Frame2 
  134.       Caption         =   "Curve"
  135.       Height          =   2535
  136.       Left            =   0
  137.       TabIndex        =   1
  138.       Top             =   0
  139.       Width           =   2295
  140.       Begin VB.OptionButton optCurve 
  141.          Caption         =   "Off Center Hexagon"
  142.          Height          =   255
  143.          Index           =   8
  144.          Left            =   120
  145.          TabIndex        =   21
  146.          Top             =   2160
  147.          Width           =   2055
  148.       End
  149.       Begin VB.OptionButton optCurve 
  150.          Caption         =   "Hexagon"
  151.          Height          =   255
  152.          Index           =   7
  153.          Left            =   120
  154.          TabIndex        =   20
  155.          Top             =   1920
  156.          Width           =   2055
  157.       End
  158.       Begin VB.OptionButton optCurve 
  159.          Caption         =   "Semicircle"
  160.          Height          =   255
  161.          Index           =   6
  162.          Left            =   120
  163.          TabIndex        =   14
  164.          Top             =   1680
  165.          Width           =   2055
  166.       End
  167.       Begin VB.OptionButton optCurve 
  168.          Caption         =   "Triangle"
  169.          Height          =   255
  170.          Index           =   0
  171.          Left            =   120
  172.          TabIndex        =   13
  173.          Top             =   240
  174.          Value           =   -1  'True
  175.          Width           =   2055
  176.       End
  177.       Begin VB.OptionButton optCurve 
  178.          Caption         =   "Star"
  179.          Height          =   255
  180.          Index           =   5
  181.          Left            =   120
  182.          TabIndex        =   6
  183.          Top             =   1440
  184.          Width           =   2055
  185.       End
  186.       Begin VB.OptionButton optCurve 
  187.          Caption         =   "Off Center Circle"
  188.          Height          =   255
  189.          Index           =   4
  190.          Left            =   120
  191.          TabIndex        =   5
  192.          Top             =   1200
  193.          Width           =   2055
  194.       End
  195.       Begin VB.OptionButton optCurve 
  196.          Caption         =   "Circle"
  197.          Height          =   255
  198.          Index           =   3
  199.          Left            =   120
  200.          TabIndex        =   4
  201.          Top             =   960
  202.          Width           =   2055
  203.       End
  204.       Begin VB.OptionButton optCurve 
  205.          Caption         =   "Off Center Square"
  206.          Height          =   255
  207.          Index           =   2
  208.          Left            =   120
  209.          TabIndex        =   3
  210.          Top             =   720
  211.          Width           =   2055
  212.       End
  213.       Begin VB.OptionButton optCurve 
  214.          Caption         =   "Square"
  215.          Height          =   255
  216.          Index           =   1
  217.          Left            =   120
  218.          TabIndex        =   2
  219.          Top             =   480
  220.          Width           =   2055
  221.       End
  222.    End
  223.    Begin VB.PictureBox picCanvas 
  224.       AutoRedraw      =   -1  'True
  225.       Height          =   5775
  226.       Left            =   2400
  227.       ScaleHeight     =   381
  228.       ScaleMode       =   3  'Pixel
  229.       ScaleWidth      =   357
  230.       TabIndex        =   0
  231.       Top             =   0
  232.       Width           =   5415
  233.    End
  234. Attribute VB_Name = "frmTrans"
  235. Attribute VB_GlobalNameSpace = False
  236. Attribute VB_Creatable = False
  237. Attribute VB_PredeclaredId = True
  238. Attribute VB_Exposed = False
  239. Option Explicit
  240. ' Location of viewing eye.
  241. Private EyeR As Single
  242. Private EyeTheta As Single
  243. Private EyePhi As Single
  244. Private Const dtheta = PI / 20
  245. Private Const Dphi = PI / 20
  246. Private Const dR = 1
  247. ' Location of focus point.
  248. Private Const FocusX = 0#
  249. Private Const FocusY = 0#
  250. Private Const FocusZ = 0#
  251. Private Projector(1 To 4, 1 To 4) As Single
  252. Private SelectedCurve As Integer
  253. Private SelectedTransformation As Integer
  254. Private NumTrans As Integer
  255. Private trans() As Transformation
  256. Private TheSurface As Transformed3d
  257. ' Create the selected curve.
  258. Private Sub CreateCurve()
  259. Dim r As Single
  260. Dim r2 As Single
  261. Dim dtheta As Single
  262. Dim theta As Single
  263. Dim Y As Single
  264. Dim i As Integer
  265.     Select Case SelectedCurve
  266.         Case 0  ' Triangle.
  267.             TheSurface.AddCurvePoint 2 * Cos(0), 0, 2 * Sin(0)
  268.             TheSurface.AddCurvePoint 2 * Cos(4 * PI / 3), 0, 2 * Sin(4 * PI / 3)
  269.             TheSurface.AddCurvePoint 2 * Cos(2 * PI / 3), 0, 2 * Sin(2 * PI / 3)
  270.             TheSurface.AddCurvePoint 2 * Cos(0), 0, 2 * Sin(0)
  271.         Case 1  ' Square.
  272.             TheSurface.AddCurvePoint -2, 0, -2
  273.             TheSurface.AddCurvePoint -2, 0, 2
  274.             TheSurface.AddCurvePoint 2, 0, 2
  275.             TheSurface.AddCurvePoint 2, 0, -2
  276.             TheSurface.AddCurvePoint -2, 0, -2
  277.         Case 2  ' Off Center Square.
  278.             TheSurface.AddCurvePoint 1, 0, 1
  279.             TheSurface.AddCurvePoint 1, 0, 3
  280.             TheSurface.AddCurvePoint 3, 0, 3
  281.             TheSurface.AddCurvePoint 3, 0, 1
  282.             TheSurface.AddCurvePoint 1, 0, 1
  283.         Case 3  ' Circle.
  284.             r = 2
  285.             dtheta = PI / 8
  286.             For theta = 0 To 2 * PI - dtheta + 0.01 Step dtheta
  287.                 TheSurface.AddCurvePoint r * Cos(theta), 0, r * Sin(theta)
  288.             Next theta
  289.             TheSurface.AddCurvePoint r, 0, 0
  290.         Case 4  ' Off Center Circle.
  291.             r = 1
  292.             dtheta = PI / 8
  293.             For theta = 0 To 2 * PI - dtheta + 0.01 Step dtheta
  294.                 TheSurface.AddCurvePoint 2 + r * Cos(theta), 0, 2 + r * Sin(theta)
  295.             Next theta
  296.             TheSurface.AddCurvePoint 2 + r, 0, 2
  297.         Case 5  ' Star.
  298.             r = 2
  299.             r2 = 1
  300.             dtheta = 2 * PI / 5 / 2
  301.             theta = PI
  302.             For i = 1 To 5
  303.                 TheSurface.AddCurvePoint _
  304.                     r * Cos(theta), 0, r * Sin(theta)
  305.                 theta = theta + dtheta
  306.                 TheSurface.AddCurvePoint _
  307.                     r2 * Cos(theta), 0, r2 * Sin(theta)
  308.                 theta = theta + dtheta
  309.             Next i
  310.             TheSurface.AddCurvePoint _
  311.                 r * Cos(PI), 0, r * Sin(PI)
  312.         Case 6  ' Semicircle.
  313.             r = 2
  314.             dtheta = PI / 8
  315.             For theta = 0 To PI - dtheta + 0.01 Step dtheta
  316.                 TheSurface.AddCurvePoint r * Cos(theta), 0, r * Sin(theta)
  317.             Next theta
  318.             TheSurface.AddCurvePoint -r, 0, 0
  319.         Case 7  ' Hexagon.
  320.             r = 3
  321.             dtheta = 2 * PI / 6
  322.             theta = 0
  323.             For i = 1 To 7
  324.                 TheSurface.AddCurvePoint _
  325.                     r * Cos(theta), 0, r * Sin(theta)
  326.                 theta = theta + dtheta
  327.             Next i
  328.         Case 8  ' Off Center Hexagon.
  329.             r = 2
  330.             dtheta = 2 * PI / 6
  331.             theta = 0
  332.             For i = 1 To 7
  333.                 TheSurface.AddCurvePoint _
  334.                     r * Cos(theta), 0, r + r * Sin(theta)
  335.                 theta = theta + dtheta
  336.             Next i
  337.     End Select
  338. End Sub
  339. ' Create the array of transformations.
  340. Private Sub CreateTransformations()
  341. Dim A(1 To 4, 1 To 4) As Single
  342. Dim B(1 To 4, 1 To 4) As Single
  343. Dim C(1 To 4, 1 To 4) As Single
  344. Dim theta As Single
  345. Dim dtheta As Single
  346. Dim r As Single
  347. Dim Y As Single
  348. Dim i As Integer
  349.     Select Case SelectedTransformation
  350.         Case 0  ' Up, twist.
  351.             NumTrans = 9
  352.             ReDim trans(1 To NumTrans)
  353.             dtheta = PI / 12
  354.             For i = 1 To NumTrans
  355.                 Y = i / 2
  356.                 theta = i * dtheta
  357.                 m3Translate A, 0, Y, 0  ' Translate.
  358.                 m3YRotate B, theta      ' Rotate.
  359.                 m3MatMultiply trans(i).M, A, B  ' Combine.
  360.             Next i
  361.         Case 1  ' Up, shrink.
  362.             NumTrans = 9
  363.             ReDim trans(1 To NumTrans)
  364.             For i = 1 To NumTrans
  365.                 Y = i / 2
  366.                 r = (NumTrans - i) / NumTrans
  367.                 m3Scale A, r, 1, r      ' Scale.
  368.                 m3Translate B, 0, Y, 0  ' Translate.
  369.                 m3MatMultiply trans(i).M, A, B  ' Combine.
  370.             Next i
  371.         Case 2  ' Up, shrink, twist.
  372.             NumTrans = 9
  373.             ReDim trans(1 To NumTrans)
  374.             dtheta = PI / 12
  375.             For i = 1 To NumTrans
  376.                 Y = i / 2
  377.                 r = (NumTrans - i) / NumTrans
  378.                 theta = i * dtheta
  379.                 m3Scale A, r, 1, r      ' Scale.
  380.                 m3Translate B, 0, Y, 0  ' Translate.
  381.                 m3MatMultiply C, A, B   ' Combine A and B.
  382.                 m3YRotate A, theta      ' Rotate.
  383.                 m3MatMultiply trans(i).M, C, A  ' Combine all.
  384.             Next i
  385.         Case 3  ' Up, shrink/grow.
  386.             NumTrans = 18
  387.             ReDim trans(1 To NumTrans)
  388.             dtheta = PI / 12
  389.             For i = 1 To NumTrans
  390.                 Y = i / 4
  391.                 theta = i * dtheta
  392.                 r = 1 + Sin(2 * theta) / 2
  393.                 m3Scale A, r, 1, r      ' Scale.
  394.                 m3Translate B, 0, Y, 0  ' Translate.
  395.                 m3MatMultiply trans(i).M, A, B  ' Combine.
  396.             Next i
  397.         Case 4  ' Waver.
  398.             ' Make the curve move upwards with
  399.             ' varying rotation around the Z axis.
  400.             NumTrans = 18
  401.             ReDim trans(1 To NumTrans)
  402.             dtheta = PI / 12
  403.             r = PI / 2
  404.             For i = 1 To NumTrans
  405.                 Y = i / 4
  406.                 theta = i * dtheta
  407.                 m3ZRotate A, r * Sin(theta)  ' Rotate.
  408.                 m3Translate B, 0, Y, 0  ' Translate.
  409.                 m3MatMultiply trans(i).M, A, B  ' Combine.
  410.             Next i
  411.         Case 5  ' Grow and rotate.
  412.             ' Make the curve grow and rotate
  413.             ' around the Z axis.
  414.             NumTrans = 18
  415.             ReDim trans(1 To NumTrans)
  416.             dtheta = PI / 12
  417.             r = PI / 2
  418.             For i = 1 To NumTrans
  419.                 Y = i / 4
  420.                 theta = i * dtheta
  421.                 m3ZRotate A, r * Sin(theta)     ' Rotate.
  422.                 m3Scale B, i / 9, i / 9, i / 9  ' Scale
  423.                 m3MatMultiply trans(i).M, A, B  ' Combine.
  424.             Next i
  425.         Case 6  ' Rotate around the X axis.
  426.             ' Rotate around the X axis.
  427.             NumTrans = 18
  428.             ReDim trans(1 To NumTrans)
  429.             dtheta = 2 * PI / NumTrans
  430.             r = PI / 2
  431.             For i = 1 To NumTrans
  432.                 Y = i / 4
  433.                 theta = i * dtheta
  434.                 m3XRotate trans(i).M, theta ' Rotate.
  435.             Next i
  436.         Case 7  ' Rotate around the Y axis.
  437.             ' Rotate around the Y axis.
  438.             NumTrans = 18
  439.             ReDim trans(1 To NumTrans)
  440.             dtheta = 2 * PI / NumTrans
  441.             r = PI / 2
  442.             For i = 1 To NumTrans
  443.                 Y = i / 4
  444.                 theta = i * dtheta
  445.                 m3YRotate trans(i).M, theta ' Rotate.
  446.             Next i
  447.         Case 8  ' Rotate around the Z axis.
  448.             ' Rotate around the Z axis.
  449.             NumTrans = 18
  450.             ReDim trans(1 To NumTrans)
  451.             dtheta = 2 * PI / NumTrans
  452.             r = PI / 2
  453.             For i = 1 To NumTrans
  454.                 Y = i / 4
  455.                 theta = i * dtheta
  456.                 m3ZRotate trans(i).M, theta ' Rotate.
  457.             Next i
  458.     End Select
  459. End Sub
  460. Private Sub chkHideSurfaces_Click()
  461.     DrawData picCanvas
  462.     picCanvas.SetFocus
  463. End Sub
  464. ' Create the surface.
  465. Private Sub cmdTransform_Click()
  466. Dim i As Integer
  467.     Screen.MousePointer = vbHourglass
  468.     DoEvents
  469.     Set TheSurface = New Transformed3d
  470.     CreateCurve
  471.     CreateTransformations
  472.     For i = 1 To NumTrans
  473.         TheSurface.SetTransformation trans(i).M
  474.     Next i
  475.     TheSurface.Transform
  476.     DrawData picCanvas
  477.     picCanvas.SetFocus
  478.     Screen.MousePointer = vbDefault
  479. End Sub
  480. ' Save the curve choice.
  481. Private Sub optCurve_Click(Index As Integer)
  482.     SelectedCurve = Index
  483. End Sub
  484. ' Draw the data.
  485. Private Sub DrawData(ByVal pic As PictureBox)
  486. Dim X As Single
  487. Dim Y As Single
  488. Dim Z As Single
  489. Dim S(1 To 4, 1 To 4) As Single
  490. Dim T(1 To 4, 1 To 4) As Single
  491. Dim ST(1 To 4, 1 To 4) As Single
  492. Dim PST(1 To 4, 1 To 4) As Single
  493.     ' Prevent overflow errors when drawing lines
  494.     ' too far out of bounds.
  495.     On Error Resume Next
  496.     ' Uncull the surface.
  497.     TheSurface.Culled = False
  498.     ' Cull backfaces.
  499.     If chkHideSurfaces.value = vbChecked Then
  500.         m3SphericalToCartesian EyeR, EyeTheta, EyePhi, X, Y, Z
  501.         TheSurface.Cull X, Y, Z
  502.     End If
  503.     ' Scale and translate so it looks OK in pixels.
  504.     m3Scale S, 30, -30, 1
  505.     m3Translate T, picCanvas.ScaleWidth / 2, picCanvas.ScaleHeight / 2, 0
  506.     m3MatMultiplyFull ST, S, T
  507.     m3MatMultiplyFull PST, Projector, ST
  508.     ' Transform the surface and clip faces.
  509.     TheSurface.ApplyFull PST
  510.     ' Clip faces behind the center of projection.
  511.     TheSurface.ClipEye EyeR
  512.     ' Set the appropriate fill style.
  513.     If chkHideSurfaces.value = vbChecked Then
  514.         ' Fill to cover hidden surfaces.
  515.         pic.FillStyle = vbFSSolid
  516.         pic.FillColor = RGB(&HC0, &HFF, &HC0)
  517.     Else
  518.         ' Do not fill so all lines are visible.
  519.         pic.FillStyle = vbFSTransparent
  520.     End If
  521.     ' Draw the surface.
  522.     pic.Cls
  523.     TheSurface.Draw pic, EyeR
  524.     pic.Refresh
  525. End Sub
  526. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  527.     Select Case KeyCode
  528.         Case vbKeyLeft
  529.             EyeTheta = EyeTheta - dtheta
  530.         
  531.         Case vbKeyRight
  532.             EyeTheta = EyeTheta + dtheta
  533.         
  534.         Case vbKeyUp
  535.             EyePhi = EyePhi - Dphi
  536.         
  537.         Case vbKeyDown
  538.             EyePhi = EyePhi + Dphi
  539.                 
  540.         Case Else
  541.             Exit Sub
  542.     End Select
  543.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  544.     DrawData picCanvas
  545. End Sub
  546. Private Sub Form_KeyPress(KeyAscii As Integer)
  547.     Select Case KeyAscii
  548.         Case Asc("+")
  549.             EyeR = EyeR + dR
  550.         
  551.         Case Asc("-")
  552.             EyeR = EyeR - dR
  553.         
  554.         Case Else
  555.             Exit Sub
  556.     End Select
  557.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  558.     DrawData picCanvas
  559. End Sub
  560. Private Sub Form_Load()
  561.     ' Initialize the eye position.
  562.     EyeR = 10
  563.     EyeTheta = PI * 0.2
  564.     EyePhi = PI * 0.1
  565.     ' Initialize the projection transformation.
  566.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  567.     Me.Show
  568.     optCurve_Click 0
  569. End Sub
  570. ' Save the current transformation choice.
  571. Private Sub optTransformation_Click(Index As Integer)
  572.     SelectedTransformation = Index
  573. End Sub
  574.